perm filename PICTUR.OLD[SYS,HE] blob
sn#021163 filedate 1973-01-22 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00008 00002 BEGIN "PICTUR"
00011 00003 α table of picture file data block names
00014 00004 α MISC. PROCEDURE
00018 00005 α BEGINNING OF TVSIX PACKAGE
00020 00006 α TVSIX REDUCTION ROUTINE
00021 00007 α Super fast averager. SUMS and CLPINC determine the number of
00024 00008 α low pass filter - START OF HIPASS PACKAGE
00029 00009 α hipass filter
00032 00010 α Compute the transformation matrices for the camera model
00035 00011 α update the camera transform
00039 00012 α Initialized the camera transform routines
00041 00013 α convert text in array to string
00043 00014 α first we initialize the world
00045 00015 α get a picture from the disk
00048 00016 α get a picture from the TV
00050 00017 α Quam sixbit or regular TV input
00052 00018 α determine which filters he wants to use
00054 00019 α set up to set sensitivity
00057 00020 α set sensitivity
00058 00021 α and, finally, take the picture
00060 00022 α and add a transform if wanted
00062 00023 α display the picture, if clear picture
00063 00024 α print the picture(s) if desired
00065 00025 α set up to output to disk if desired
00068 00026 α and write it out
00070 ENDMK
⊗;
BEGIN "PICTUR"
REQUIRE "HELIB[1,3]" LIBRARY;
REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
REQUIRE "VIDSUB[1,PDQ]" LOAD_MODULE;
REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
REQUIRE "PROLOG.HDR[1,PDQ]" SOURCE_FILE;
REQUIRE 2000 STRING_SPACE;
REQUIRE "⊂⊃||" DELIMITERS;
DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, INT=⊂INTEGER⊃, PRO=⊂PROCEDURE⊃,
CRLF=⊂'15&'12⊃, BHEAD(BUF)=⊂((BUF+1) LAND '777777)⊃, REF=⊂REFERENCE⊃,
QUEST(NOVICE,QUESTION,TEST)=
⊂BEGIN IF ¬EXP THEN OUTSTR("NOVICE"&CRLF);
DO OUTSTR("QUESTION"&CRLF)
UNTIL TEST; END⊃,
XPOINT(S,L,P)=⊂((35-(P)) LSH 30)+((S) LSH 24)+(L)⊃,
RED=⊂2⊃, BLUE=⊂3⊃, GREEN=⊂4⊃, CLEAR=⊂1⊃, XDATA=⊂3⊃, P=⊂'17⊃,
Q=⊂'10000⊃, HAT(X,Y)=⊂(((X)-1) DIV (Y) +1)⊃;
EXT PRO PICINI(INT CHAN, FILE, EXTEN, PPN;REF BOOLEAN FAIL;INT ARRAY STOR);
EXT PRO PICRD(REF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO PICWR(INT CHAN, FILE, EXTEN, PPN; REF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO RELCOR(INT IOWD);
EXT INT PRO GETCOR(INT SIZE);
EXT BOOLEAN PRO VIDEO(INT EXP, X,Y);
EXT PRO INP;
EXT INT PRO GIOWD(INT ARRAY BUF);
EXT PRO EYECAL(INT SIZE, FRAM, FLAG; INT ARRAY BUF);
EXT PRO ADJUST;
EXT PRO CWHEEL(INT CODE);
EXT PRO TVIN;
EXT PRO PRDUMP;
EXT PRO PORTR;
FORTRAN REAL PROCEDURE SIN;
FORTRAN REAL PROCEDURE COS;
FORTRAN REAL PROCEDURE SQRT(REAL X);
EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
EXTERNAL PROCEDURE CALLEN;
EXTERNAL PROCEDURE SPWOFF;
EXT PRO SUMSUB(INT ARRAY TV;INT OPTR1,OPTR2,OPTR3);
EXT PROCEDURE INVRT(REAL ARRAY A,AI);
α table of picture file data block names;
PRELOAD_WITH "LEFT (ONLY) CLEAR IMAGE",
"LEFT (ONLY) RED IMAGE",
"LEFT (ONLY) BLUE IMAGE",
"LEFT (ONLY) GREEN IMAGE",
"TITLE",
"DESCRIPTION",
"LEFT (ONLY) CAMERA TRANSFORM",
"LEFT (ONLY) CLEAR CODE TABLE",
"RIGHT CLEAR IMAGE",
"RIGHT RED IMAGE",
"RIGHT BLUE IMAGE",
"RIGHT GREEN IMAGE",
"RIGHT CAMERA TRANSFORM",
"RIGHT CLEAR CODE TABLE",
"STEREO REGISTRATION TABLE",
"MISC. 16",
"MISC. 17",
"MISC. 18",
"MISC. 19",
"MISC. 20",
"MISC. 21",
"MISC. 22",
"MISC. 23",
"MISC. 24",
"MISC. 25";
SAFE STRING ARRAY PICDES[1:25];
SAFE INTEGER ARRAY PICALLOC[1:25]; α allocation table for data blocks;
PRELOAD_WITH "Clear","Red", "Blue", "Green";
SAFE STRING ARRAY FILNAM[1:4];
PRELOAD_WITH 3,0,1,2;
SAFE INT ARRAY COLNUM[1:4];
EXT INT TVWORD, FLINE, LLINE, RSIDE, LSIDE, TCLIP, BCLIP, PRTBUF, IWID,
L1, L2, L3, P1,P2,P3,STATUS,TSERVO,LENS, BITS, LINLEN, LINES;
SAFE INT ARRAY PNTRS[1:25], DPYBUF[1:600], CLIPS[1:4,1:3], PIC[0:9];
SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,
MART,SWING,FOC,FOCLEN0,FOCLENG[1:4],DP,P0[1:4,1:3],PP[1:4,1:2];
INT I,EXP,ANS,FSAV,LLSAV,RSAV,LSAV,TVLENG,PICNUM,CAMERR,SUMS,CLPINC,
MIN,MAX,SUMPT1,SUMPT2,SUMPT3,TVSIZE,PICSIZE;
REAL PANPOT, FOCPOT, TILPOT;
LABEL LOOP, SKIP, SKIP1;
BOOLEAN SENSSET, TVREAD, SIXBIT;
STRING STR, TITLE, DESCRIPT;
α MISC. PROCEDURE;
SIMPLE REAL PROCEDURE LNS(REAL X; INTEGER RLENS);
RETURN(X*FOC[RLENS]/(X-FOC[RLENS]));
α INDIRECT ARRBLT;
SIMPLE PROCEDURE ARRTO(INTEGER TOO; REFERENCE INTEGER FROM; INTEGER LENG);
START_CODE JRST ARRBLT; END;
SIMPLE PROCEDURE ARRFROM(REFERENCE INTEGER TOO; INTEGER FROM, LENG);
START_CODE JRST ARRBLT; END;
SIMPLE PROCEDURE ARRTOR(INTEGER TOO; REFERENCE REAL FROM;INTEGER LENG);
START_CODE JRST ARRBLT; END;
α Conversion from Quam format picture header array to hand-eye
library style parameters;
SIMPLE PROCEDURE Q2HE(SAFE INTEGER ARRAY PIC);
BEGIN
IWID←PIC[SIZEX];
FLINE←PIC[POSY];
LSIDE←PIC[POSX];
RSIDE←LSIDE+IWID-1;
LLINE←FLINE+PIC[SIZEY]-1;
LINLEN←PIC[SIZEL];
BITS←PIC[BIT];
END "Q2HE";
α Conversion from hand-eye library parameters to Quam format picture
header array;
SIMPLE PROCEDURE HE2Q(SAFE INTEGER ARRAY PIC);
BEGIN
PIC[SCALEX]←PIC[SCALEY]←1;
PIC[POSX]←LSIDE;
PIC[POSY]←FLINE;
PIC[SIZEX]←RSIDE-LSIDE+1;
PIC[SIZEY]←LLINE-FLINE+1;
PIC[SIZEL]←HAT(PIC[SIZEX],36 DIV BITS);
PIC[BIT]←BITS;
END "HE2Q";
α BEGINNING OF TVSIX PACKAGE;
SIMPLE PROCEDURE MINMAX(SAFE INTEGER ARRAY PARS);
BEGIN INTEGER NI,NJ;
NI←LINLEN*3;
NJ←PARS[SIZEY];
START_CODE
LABEL LI,LJ;
DEFINE A=⊂1⊃,I=⊂2⊃,J=⊂3⊃,P1=⊂4⊃,P2=⊂5⊃,P3=⊂6⊃;
DEFINE FOO(X)=⊂
ILDB A,X;
CAMGE A,MIN;
MOVEM A,MIN;
CAMLE A,MAX;
MOVEM A,MAX;⊃;
MOVE P1,SUMPT1;
MOVE P2,SUMPT2;
MOVE P3,SUMPT3;
MOVE J,NJ;
LJ: MOVE I,NI;
LI: FOO(P1)
FOO(P2)
FOO(P3)
SOJG I,LI;
SOJG J,LJ;
END;
END "MINMAX";
α Determines the size array needed for picture PIC,
allocates an array,
and sets and returns the appropriate PTR parameter;
INTEGER SIMPROC PICMAK(PICTURE PIC);
BEGIN
IF PIC[SIZEX]=0 THEN RETURN(0);
PIC[SIZEL]←HAT(PIC[SIZEX],36 DIV PIC[BIT]);
PICSIZE ← GETCOR(PIC[SIZEL]*PIC[SIZEY]);
RETURN(PIC[PTR]←XPOINT(PIC[BIT],BHEAD(PICSIZE),-1));
END "PICMAK";
α TVSIX REDUCTION ROUTINE;
SIMPLE PROCEDURE REDUCER(SAFE INTEGER ARRAY PARS);
BEGIN
INTEGER NI,NJ,RPT,LL,SCALE;
SCALE←(64*Q-1)%(MAX-MIN);
NI←3*LINLEN;
NJ←PARS[SIZEY];
RPT←PARS[PTR];
LL←PARS[SIZEL];
START_CODE
LABEL L,LI;
DEFINE A=⊂1⊃,I=⊂2⊃,J=⊂3⊃,P1=⊂4⊃,P2=⊂5⊃,P3=⊂6⊃,R=⊂7⊃;
DEFINE FOO(X)=⊂
ILDB A,X;
SUB A,MIN;
IMUL A,SCALE;
ASH A,'777764;
IDPB A,R;⊃;
MOVE P1,SUMPT1;
MOVE P2,SUMPT2;
MOVE P3,SUMPT3;
MOVE R,RPT;
MOVE J,NJ;
LI: MOVE I,NI;
L: FOO(P1)
FOO(P2)
FOO(P3)
SOJG I,L;
MOVE R,LL;
ADDB R,RPT;
SOJG J,LI;
END;
END "REDUCER";
α Super fast averager. SUMS and CLPINC determine the number of
averages and clip level ranges;
PROCEDURE SUMMER(INTEGER ARRAY PARS,SUM;INTEGER SUMS,CLPINC);
BEGIN
LINLEN←(PARS[SIZEX]-1)%9+1;
TVSIZE←LINLEN*LINES;
BEGIN INTEGER ARRAY TVBUF[1:TVSIZE];
INTEGER SUMCNT;
SUMPT1←POINT(12,SUM[1,1,1],-1);
SUMPT2←SUMPT1+TVSIZE;
SUMPT3←SUMPT2+TVSIZE;
MIN←1 LSH 34;
MAX←0;
TVWORD←GIOWD(TVBUF);
FOR SUMCNT←1 STEP 1 UNTIL SUMS DO
BEGIN
TCLIP←0;
BCLIP←CLPINC-1;
WHILE BCLIP ≤ 7 DO
BEGIN
TVIN;
SUMSUB(TVBUF,SUMPT1,SUMPT2,SUMPT3);
TCLIP←TCLIP+CLPINC;
BCLIP←BCLIP+CLPINC;
END;
END;
END;
END "SUMMER";
PROCEDURE TVSIX(SAFE INTEGER ARRAY PARS;INTEGER SUMS,CLPINC);
BEGIN INTEGER ADR, TVSAV;
PARS[SIZEL]←(PARS[SIZEX]-1)%6+1;
TVSAV ← TVWORD;
ADR←(TVWORD+1) LAND '777777;
PARS[PTR]←XPOINT(6,ADR,-1);
PARS[BIT]←6;
Q2HE(PARS);
LINLEN←(PARS[SIZEX]-1)%9+1;
LINES←LLINE-FLINE+1;
BEGIN INTEGER ARRAY SUM[1:3,1:LINES,1:LINLEN];
SUMMER(PARS,SUM,SUMS,CLPINC);
MINMAX(PARS);
REDUCER(PARS);
END;
TVWORD ← TVSAV;
END "TVSIX";
α low pass filter - START OF HIPASS PACKAGE;
PROCEDURE LOPASS(PICTURE PIC,OUT;INTEGER AVGX,AVGY);
BEGIN INTEGER_ARRAY COLSUM,COLN[-AVGX+1:PIC[SIZEX]];
INTEGER I,J,HH,OI,OPT1,PT1,OPT2,PT2,OPTO,PTO,S,N,AVGX2,AVGY2,
SIZL,AVGTSH;
AVGX2←AVGX DIV 2;
AVGY2←AVGY DIV 2;
SIZL←PIC[SIZEL];
AVGTSH←AVGX*AVGY/4;
HH←PIC[SIZEX];
OI←-(PIC[SIZEX]+AVGX2);
OPT1←0;
OPT2←PIC[PTR];
OPTO←0;
FOR J←1 STEP 1 UNTIL PIC[SIZEY]+AVGY2 DO
BEGIN "LJ"
IF J=AVGY2+1 THEN OPTO←OUT[PTR]
ELSE IF J=AVGY+1 THEN OPT1←PIC[PTR]
ELSE IF J>PIC[SIZEY] THEN OPT2←0;
PT1←OPT1;
PT2←OPT2;
PTO←OPTO;
START_CODE
DEFINE A=⊂1⊃,B=⊂2⊃,I=⊂3⊃,G=⊂4⊃,N=⊂5⊃,S=⊂6⊃,H=⊂7⊃;
LABEL LI,LIA,LIB,LIC,LID,LI3,LI1,LI2,LIX;
MOVE COLSUM;
HRRM LIB;
ADD AVGX;
HRRM LIA;
MOVE COLN;
HRRM LID;
ADD AVGX;
HRRM LIC;
MOVE G,AVGX2;
MOVE H,HH;
SETZB N,S;
HRLZ I,OI;
LI: SOJL H,LI3;
ILDB B,PT1;
ILDB A,PT2;
JUMPE B,LI1;
JUMPE A,LI2;
SUB A,B;
LIA: ADDB A,(I);
LIC: ADD N,(I);
LIB: SUB A,(I);
LID: SUB N,(I);
ADDB S,A;
IDIV A,N;
CAMG N,AVGTSH;
MOVEI A,0;
SOSGE G;
IDPB A,PTO;
AOBJN I,LI;
JRST LIX;
LI3: SETZB A,B;
JRST LIB;
LI1: JUMPE A,LIA;
AOS @LIC;
JRST LIA;
LI2: MOVN A,B;
SOS @LIC;
JRST LIA;
LIX: END;
OPT1←OPT1+SIZL;
OPT2←OPT2+SIZL;
OPTO←OPTO+SIZL;
END "LJ";
END "LOPASS";
α hipass filter;
INTEGER PROCEDURE DIFFPIC(PICTURE INP,INP2,OUT;REAL K1,K2,OFF);
BEGIN α PICTURE DIFFERENCER, INP-INP2 COPIED TO OUT;
INTEGER IBITS,ADR,PTI,PTI2,PTO,NX,NY,NLI,OFF2,MAXV;
BOOLEAN INPLACE;
SHORT INTEGER I;
INTEGER_ARRAY CTAB[0:MAXV←1 LSH (IBITS←INP[BIT])-1];
PTI←INP[PTR];
PTI2←INP2[PTR];
OFF2←1 LSH (IBITS-1);
NLI←INP[SIZEL];
NX←INP[SIZEX];
NY←INP[SIZEY];
PTO←OUT[PTR];
CTAB[0]←-INFINITY;
FOR I←1 STEP 1 UNTIL MAXV DO CTAB[I]←(OFF-I*K2)/K1+OFF2;
START_CODE
LABEL LI,LJ,LJ2,LNEG,LI2,LX,LX2;
DEFINE A=⊂'14⊃,B=⊂'15⊃,I=⊂'13⊃,PI1=⊂'10⊃,PI2=⊂'7⊃,PO=⊂'11⊃;
MOVE PI1,PTI;
MOVE PI2,PTI2;
MOVE PO,PTO;
HRR 5,CTAB;
HRRM 5,LX;
HRR 5,MAXV;
HRRM 5,LX2;
LJ: MOVE I,NX;
LI: ILDB A,PI1;
ILDB B,PI2;
JUMPE A,LI2;
LX: ADD A,(B);
JUMPL A,LNEG;
LX2: CAIL A, ;
HRRZ A,LX2;
LI2: IDPB A,PO;
SOJG I,LI;
JRST LJ2;
LNEG: SKIPE A,B;
MOVEI A,1;
JRST LI2;
LJ2: MOVE PI1,NLI;
MOVE PI2,PI1;
ADDB PI1,PTI;
ADDB PI2,PTI2;
MOVE PO,NLI;
ADDB PO,PTO;
SOSLE NY;
JRST LJ;
END;
RETURN(ADR);
END "DIFFPIC";
α This procedure performs a simple minded high-pass spacial filter
on picture INP producing picture OUT.
OUT[i,j]←INP[i,j]-K1*LOWPASS(INP)[i,j]+k2, where LOWPASS[i,j]
is the local average intensity of INP computed on a window
AVGX by AVGY pixels in size centered at i,j;
PROCEDURE HIPASS;
BEGIN
SAFE INTEGER ARRAY PIC,LO[0:PICMAX];
HE2Q(PIC);
PIC[PTR]←XPOINT(PIC[BIT],BHEAD(TVWORD),-1);
PIC[GAIN]←-PIC[GAIN];
ARRTRAN(LO,PIC);
LO[NAME] ← 0;
PICMAK(LO);
LOPASS(PIC,LO,21,21);
DIFFPIC(PIC,LO,PIC,1,0.7,0);
RELCOR(PICSIZE);
PIC[PTR] ← LO[PTR] ← 0;
Q2HE(PIC);
END;
α Compute the transformation matrices for the camera model
-FMX/333 and PP[2]-PP[1]/333 are corrections for the non-orthogonality
of the TV scan axes;
PROCEDURE PANTIL(INTEGER C;REAL PPOT,TPOT,FPOT;REAL ARRAY COL,ICOL,CENTER);
BEGIN INTEGER I,J;
REAL ACC,FMX,FMY,PAN,TILT;
REAL ARRAY RP,RT,RPT,RS,R[1:3,1:3],CC[1:3];
PAN ← PPOTD[C]*PPOT+PPOT0[C];
TILT ← TPOTD[C]*TPOT+TPOT0[C];
FMY ← FPOTD[C]*FPOT+FPOT0[C];
FMX ← FMY*MART[C];
RP[2,3]←-1;
RPT[1,1]←RP[1,1]←RP[3,2]←-SIN(PAN);
RP[3,1]←-(RPT[1,2]←RP[1,2]←COS(PAN));
RT[1,1]←1;
RPT[2,3]←-(RT[2,2]←RT[3,3]←COS(TILT));
R[3,3]←RPT[3,3]←RT[2,3]←-(RT[3,2]←SIN(TILT));
RPT[2,1]←RT[2,3]*RP[3,1];
RPT[2,2]←RT[2,3]*RP[3,2];
R[3,1]←RPT[3,1]←RT[3,3]*RP[3,1];
R[3,2]←RPT[3,2]←RT[3,3]*RP[3,2];
RS[3,3]←1;
RS[1,1]←RS[2,2]←COS(SWING[C]);
RS[2,1]←-(RS[1,2]←SIN(SWING[C]));
R[1,1]←RS[1,1]*RPT[1,1]+RS[1,2]*RPT[2,1];
R[1,2]←RS[1,1]*RPT[1,2]+RS[1,2]*RPT[2,2];
R[1,3]←RS[1,2]*RPT[2,3];
R[2,1]←RS[2,1]*RPT[1,1]+RS[2,2]*RPT[2,1];
R[2,2]←RS[2,1]*RPT[1,2]+RS[2,2]*RPT[2,2];
R[2,3]←RS[2,2]*RPT[2,3];
CC[1]←P0[C,1]+R[1,1]*DP[C,1]+R[2,1]*DP[C,2]+R[3,1]*DP[C,3];
CC[2]←P0[C,2]+R[1,2]*DP[C,1]+R[2,2]*DP[C,2]+R[3,2]*DP[C,3];
CC[3]←P0[C,3]+R[1,3]*DP[C,1]+R[2,3]*DP[C,2]+R[3,3]*DP[C,3];
FOR I←1 STEP 1 UNTIL 3 DO
BEGIN
COL[I,1]←R[I,1];
COL[I,2]←R[I,2];
ACC←0;
FOR J←1 STEP 1 UNTIL 3 DO ACC←ACC-R[I,J]*CC[J];
COL[I,3]←ACC;
END;
FOR J←1 STEP 1 UNTIL 3 DO
BEGIN
COL[2,J]←-FMX/333*COL[1,J]+FMY*COL[2,J]
+(PP[C,2]-PP[C,1]/333)*COL[3,J];
COL[1,J]←FMX*COL[1,J]+PP[C,1]*COL[3,J];
END;
INVRT(COL,ICOL);
ARRTRAN(CENTER,CC);
END "PANTIL";
α update the camera transform;
INTEGER PROCEDURE CAM_UPDATE;
BEGIN
INTEGER SFOC,STIL,SPAN,IND,FMAX,FMIN,TMAX,TMIN,PMAX,PMIN,
DIFFOC,DIFTIL,DIFPAN,SIND,UPDFLG;
LABEL ETA;
SAFE REAL ARRAY MCOL,MICOL [1:3,1:3];
SAFE REAL ARRAY LCEN[1:3];
ETA: UPDFLG ← SFOC←STIL←SPAN←0;
FMAX←TMAX←PMAX←-10000;
FMIN←TMIN←PMIN←10000;
STATUS←1;
SPWON(1,TSERVO);
FOR IND←0 STEP 1 UNTIL 39 DO
BEGIN
STATUS←4;
WHILE ¬(STATUS LAND 1) DO;
IF (STATUS≥'100)∧(STATUS<'100000) THEN DONE;
SFOC←SFOC+P1;
STIL←STIL+P2;
SPAN←SPAN+P3;
IF P1>FMAX THEN FMAX←P1;
IF P1<FMIN THEN FMIN←P1;
IF P2>TMAX THEN TMAX←P2;
IF P2<TMIN THEN TMIN←P2;
IF P3>PMAX THEN PMAX←P3;
IF P3<PMIN THEN PMIN←P3;
END;
SPWOFF;
IF IND>0 THEN
BEGIN
L1←FOCPOT←SFOC/IND;
L2←TILPOT←STIL/IND;
L3←PANPOT←SPAN/IND;
IF IND<30 THEN
BEGIN
OUTSTR("NOT ENOUGH READINGS ("&CVS(IND)&")"&CRLF);
UPDFLG←8;
END ELSE BEGIN
DIFFOC←FMAX-FMIN;
DIFTIL←TMAX-TMIN;
DIFPAN←PMAX-PMIN;
SIND←4*SQRT(IND);
IF (DIFPAN/SIND>.5)∨(DIFTIL/SIND>.25)∨
(DIFFOC/SIND>1) THEN BEGIN
OUTSTR("POTS TOO NOISY ("&CVS(DIFFOC)&" "&
CVS(DIFTIL)&" "&CVS(DIFPAN)&")"&
CRLF);
UPDFLG←9;
END;
END;
END ELSE BEGIN
OUTSTR("CAM_UPDATE: AD NOT AVAILABLE"&CRLF);
UPDFLG←10;
END;
IF UPDFLG≠0 THEN
BEGIN
OUTSTR("...TYPE Y TO TRY AGAIN:"&CRLF);
IF INCHWL= "Y" THEN GOTO ETA;
IF UPDFLG=10 THEN
BEGIN
OUTSTR("CAMERA MODEL NOT UPDATED!"&CRLF);
RETURN(UPDFLG);
END;
END;
CALLEN;
PANTIL(LENS,PANPOT,TILPOT,FOCPOT,MCOL,MICOL,LCEN);
α Now to update the global model;
ARRBLT (CAMERA_MODEL[1,1],MCOL[1,1],9);
ARRBLT (CAMERA_MODEL[6,1],MICOL[1,1],9);
ARRBLT (CAMERA_MODEL[4,1],LCEN[1],3);
CAMERA_MODEL[5,1] ← PP[LENS,1];
CAMERA_MODEL[5,2] ← PP[LENS,2];
CAMERA_MODEL[5,3] ← 1.0;
CAMERA_MODEL[9,1]←PPOTD[LENS]*PANPOT+PPOT0[LENS];
CAMERA_MODEL[9,2]←TPOTD[LENS]*TILPOT+TPOT0[LENS];
CAMERA_MODEL[9,3]←LNS(FOCLEN0[LENS]+FOCLENG[LENS]*FOCPOT,LENS);
CAMERA_MODEL[10,2]←LENS;
RETURN(UPDFLG);
END "CAM_UPDATE";
α Initialized the camera transform routines;
INTEGER PROCEDURE CAM_INIT;
BEGIN INTEGER J, BLOCK;
INTEGER PROCEDURE DATXFR; α READS DATA IN GILL'S FORMAT;
BEGIN BOOLEAN FLAG;
INTEGER I;
DEFINE DATASET=⊂"DATA[SYS,HE]"⊃;
DEFINE XFR(X)=⊂ARRYIN(XDATA,X,1)⊃;
OPEN(XDATA,"DSK",12,3,0,0,0,0);
LOOKUP(XDATA,DATASET,FLAG);
IF FLAG THEN
BEGIN
OUTSTR("LOOKUP FAILED FOR "&DATASET&CRLF);
RETURN(7);
END;
USETI(XDATA,1);
WORDIN(XDATA);
USETI(XDATA,BLOCK);
XFR(PPOT0[BLOCK]);
XFR(PPOTD[BLOCK]);
XFR(TPOT0[BLOCK]);
XFR(TPOTD[BLOCK]);
XFR(FPOT0[BLOCK]);
XFR(FPOTD[BLOCK]);
XFR(MART[BLOCK]);
XFR(SWING[BLOCK]);
FOR I←1,2 DO XFR(|PP[BLOCK,I]|);
FOR I←1,2,3 DO XFR(|P0[BLOCK,I]|);
FOR I←1,2,3 DO XFR(|DP[BLOCK,I]|);
XFR(FOC[BLOCK]);
XFR(FOCLEN0[BLOCK]);
XFR(FOCLENG[BLOCK]);
RELEASE(XDATA);
RETURN(0);
END "DATXFR";
FOR BLOCK←1 STEP 1 UNTIL 4 DO IF (J←DATXFR) THEN RETURN(J);
RETURN(0);
END"CAM_INIT";
α convert text in array to string;
STRING PROCEDURE STRCOM(INTEGER BUF);
BEGIN STRING FOO;
INTEGER STRT, LENG;
FOO ← NULL;
LENG ← ABS(BUF DIV (2↑18))+1;
STRT ← BHEAD(BUF);
BEGIN INTEGER ARRAY X[1:LENG];
INTEGER I, J;
ARRFROM(X[1],STRT,LENG);
FOR I←1 STEP 1 UNTIL LENG DO
BEGIN STRING Y;
Y ← CVSTR(X[I]);
FOR J←1 STEP 1 UNTIL 5 DO IF ¬Y[J FOR 1] THEN
RETURN(FOO&(Y[1 TO J-1]));
FOO ← FOO&Y;
END;
END;
RETURN(FOO);
END;
α convert string to text in array;
INTEGER PROCEDURE ARRYCOM(STRING S);
BEGIN INTEGER STRT, LENG, BUF;
LENG ← LENGTH(S);
LENG ← IF ¬(LENG MOD 5) THEN LENG DIV 5 ELSE (LENG DIV 5)+1;
BEGIN INTEGER ARRAY X[1:LENG];
INTEGER I;
FOR I←1 STEP 1 UNTIL LENG DO
BEGIN
X[I] ← CVASC(S[1 FOR 5]);
S ← S[6 TO ∞];
END;
BUF ← GETCOR(LENG);
STRT ← BHEAD(BUF);
ARRTO(STRT,X[1],LENG);
END;
RETURN(BUF);
END;
α first we initialize the world;
TCLIP ← 0;
BCLIP ← 7;
SENSSET ← EXP ← FALSE;
CLIPS[1,1] ← -1;
ARRBLT(CLIPS[1,2],CLIPS[1,1],11);
PICALLOC[1] ← PNTRS[1] ← 0;
CAMERR ← CAM_INIT;
ARRBLT(PICALLOC[2],PICALLOC[1],24);
ARRBLT(PNTRS[2],PNTRS[1],24);
QUEST (|Responses to questions are the upper case letters in the"&
CRLF&" question. All responses must be ended by a carriage"
&" return."&CRLF&"Novices taking pictures for printer "&
"output should,"&CRLF&" if in doubt, give the first reply "&
"indicated.|,
|are you an expert at running this program? (No or Yes)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
EXP ← ANS="Y";
LOOP: QUEST (|You can enter a picture live from the TV camera "&crlf&
"or a stored picture from the disk.|,
|Tv or Disk image?|,
|(ANS←INCHWL)="D"∨ANS="T"|);
IF ANS="D" THEN
α get a picture from the disk;
BEGIN "DISKIN"
INT FILE, EXTEN, PPN, FAIL;
TVREAD ← FALSE;
QUEST (|file names are of the form NAME.EXT[PRJ,PRG] where"
&crlf&"everything but NAME is optional.|,
|FILE NAME=|,TRUE);
FILE ← CVFIL(STR←INCHWL,EXTEN,PPN);
PICINI(1,FILE,EXTEN,PPN,FAIL,PNTRS);
IF FAIL THEN USERERR(0,0,"LOOKUP ON FILE "&STR&" FAILED");
OUTSTR("PICTURE FILE "&STR&" CONSISTS OF:"&CRLF);
FOR I←1 STEP 1 UNTIL 25 DO
IF PNTRS[I] THEN OUTSTR(" "&PICDES[I]&CRLF);
QUEST (| You can read in the entire picture file or "&
"select any of the parts listed.|,
|All parts or Select?|,
|(ANS←INCHWL)="A"∨ANS="S"|);
IF ANS="S" THEN OUTSTR("type 'Y' for parts wanted,"&
"anything else if not wanted"&CRLF);
FOR I←1 STEP 1 UNTIL 25 DO IF PNTRS[I] THEN
BEGIN "GETPART"
IF ANS="S" THEN OUTSTR(" "&PICDES[I]&"?");
IF ANS≠"S"∨INCHWL="Y" THEN PNTRS[I]←
BHEAD((PICALLOC[I]←GETCOR(PNTRS[I])))
ELSE PNTRS[I] ← PICALLOC[I] ← 0;
END "GETPART" ELSE PNTRS[I] ← PICALLOC[I] ← 0;
PICRD(FAIL,PNTRS);
IF FAIL THEN USERERR(0,0,"INPUT OF FILE "&STR&" FAILED");
TVLENG ← (((RSIDE-LSIDE)/9)+1)*(LLINE-FLINE+1);
TITLE ← IF PNTRS[5] THEN STRCOM(PICALLOC[5]) ELSE NULL;
DESCRIPT ← IF PNTRS[6] THEN STRCOM(PICALLOC[6]) ELSE NULL;
OUTSTR("PICTURE TITLE IS:"&(IF LENGTH(TITLE) THEN TITLE
ELSE "none")&CRLF);
IF LENGTH(DESCRIPT) THEN
BEGIN "OUTDES"
OUTSTR("picture has a description which is "&
CVS(LENGTH(DESCRIPT))&
" characters long"&CRLF);
OUTSTR("do you want to see it (Yes or No)?");
IF INCHWL="Y" THEN OUTSTR(DESCRIPT&CRLF);
END "OUTDES";
END "DISKIN" ELSE
α get a picture from the TV;
BEGIN "TVIN"
QUEST (|You can now set the area of the TV image to be "&
"read in."&crlf&"The white rectangle on the "&
"TV monitor shows the area being read."&crlf&
"The four knobs on the pot box near console 21 "&
"change the rectangle."&crlf&"12 and 13 change "&
"the location of the upper left corner."&crlf&
"Knobs 14 and 15 change the length and width.|,
| |,TRUE);
α adjust size if picture, if desired;
IF TVREAD THEN
BEGIN "ADJREC"
QUEST (| |,|same area as last time? (Yes or No)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN GO TO SKIP;
END "ADJREC";
OUTSTR("Adjust the image. Type any character when you "&
"are done."&CRLF);
BEGIN INTEGER ARRAY BUF[1:10000];
TVWORD ← GIOWD(BUF);
INP;
CLRBUF;
FSAV ← FLINE;
LLSAV ← LLINE;
RSAV ← RSIDE;
LSAV ← LSIDE;
END;
DESCRIPT ← TITLE ←NULL;
α Quam sixbit or regular TV input;
SKIP: QUEST (|You can read in a normal 4 bit TV image,"&
crlf&"or an averaged 6 bit image.|,
|4 Bit or 6 bit image (4 or 6)?|,
|(BITS←CVD(INCHWL))=6∨BITS=4|);
IF (SIXBIT←BITS=6) THEN
BEGIN "QUAM"
OUTSTR("Number of images to average (4 is good) = ");
SUMS ← CVD(INCHWL);
OUTSTR("Clip level spread (2 is good) = ");
CLPINC ← CVD(INCHWL);
OUTSTR("Adjust target voltage for good image"&crlf);
OUTSTR("Pot 12 controls position of scan line"&crlf);
OUTSTR("Type Y when finished");
TCLIP ← 0;
BCLIP ← 7;
CWHEEL(3);
EYECAL(600,1,FALSE,DPYBUF);
CLRBUF;
FLINE ← FSAV;
LLINE ← LLSAV;
RSIDE ← RSAV;
LSIDE ← LSAV;
BITS ← 6;
RELPOG(1);
END "QUAM";
ADJUST;
TVLENG ← ((RSIDE-LSIDE+1)/(36 DIV BITS)+1)*(LLINE-FLINE+1);
α determine which filters he wants to use;
QUEST (| This program can read a black & white picture,"&
crlf&"a color picture (using the blue, green,"&
" and red filters)"&crlf&
"or a mixture|,
|Black & white, Color, or you Select filters?|,
|(ANS←INCHWL)="B"∨ANS="C"∨ANS="S"|);
TVREAD ← TRUE;
PICNUM ← 1;
IF ANS="B" THEN PICALLOC[CLEAR] ← GETCOR(TVLENG) ELSE
IF ANS="C" THEN
BEGIN
PICALLOC[RED] ← GETCOR(TVLENG);
PICALLOC[BLUE] ← GETCOR(TVLENG);
PICALLOC[GREEN] ← GETCOR(TVLENG);
PICNUM ← 3;
END ELSE BEGIN
OUTSTR("type Y for filters desired"&CRLF);
PICNUM ← 0;
FOR I ← 1 STEP 1 UNTIL 4 DO
BEGIN
OUTSTR(FILNAM[I]&" FILTER?");
IF INCHWL="Y" THEN
BEGIN
PICALLOC[I] ← GETCOR(TVLENG);
PICNUM ← PICNUM+1;
END;
END;
END;
IF ¬PICNUM THEN
BEGIN
OUTSTR("You have to select at least one !!!"&CRLF);
GO TO SKIP;
END;
α set up to set sensitivity;
IF SIXBIT THEN GO TO SKIP1;
IF SENSSET THEN
BEGIN "ALLSET"
QUEST (|you can change the sensitivity again or use"
&" the"&crlf&"same settings as the last "&
"picture you read|,
|change sensitivity? (No or Yes)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="N" THEN GO TO SKIP1;
END "ALLSET" ELSE BEGIN "STEST"
SENSSET ← TRUE;
QUEST (| You can adjust the TV sensitivity to get "&
"the contrast"&CRLF&"you want. A "&
"horizontal line, whose position is "&
"controlled"&crlf&"by knob 12 of the pot "&
"box, is read in and an intensity"&crlf&
"vs. position display is shown. The clip "&
"levels can be changed by "&crlf&
"knobs 14 and 15. (0≤TCLIP≤BCLIP≤7)|,
|set clips? (Yes or No)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="N" THEN GO TO SKIP1;
END "STEST";
IF PICNUM>1 THEN
BEGIN "SETSEL"
QUEST (| You may set the sensitivity for each "&
"filter seperately,"&crlf&"or for all at "&
"once, using one of the filters you "&
"selected.|,
|set sensitivity for All or One?|,
|(ANS←INCHWL)="A"∨ANS="O"|);
IF ANS="A" THEN FOR I←1 STEP 1 UNTIL 4 DO
CLIPS[I,1]←-2 ELSE
BEGIN "WHICH" LABEL LOOP1;
LOOP1: STR ← "set sensitivity with filter:";
FOR I←1 STEP 1 UNTIL 4 DO
IF PICALLOC[I] THEN
STR ← STR&" "&FILNAM[I];
OUTSTR(STR&"?");
ANS ← INCHWL;
I←IF ANS="R" THEN 1 ELSE
IF ANS="B" THEN 2 ELSE
IF ANS="G" THEN 3 ELSE
IF ANS="C" THEN 4 ELSE 0;
IF ¬(I∧PICALLOC[I]) THEN GO TO LOOP1 ELSE
CLIPS[I,1]←-2;
END "WHICH";
END "SETSEL" ELSE
FOR I←1 STEP 1 UNTIL 4 DO CLIPS[I,1]←-2;
α set sensitivity;
OUTSTR("Type Y when satisfied"&crlf);
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I]∧CLIPS[I,1]=-2 THEN
BEGIN "SENSET"
OUTSTR(FILNAM[I]&" FILTER"&CRLF);
CWHEEL(COLNUM[I]);
EYECAL(600,1,TRUE,DPYBUF);
CLIPS[I,1] ← BCLIP;
CLIPS[I,2] ← TCLIP;
CLRBUF;
END "SENSET";
RELPOG(1);
SKIP1: FOR I←1 STEP 1 UNTIL 4 DO IF CLIPS[I,1]<0 THEN
BEGIN
CLIPS[I,1] ← BCLIP;
CLIPS[I,2] ← TCLIP;
END;
α and, finally, take the picture;
FLINE ← FSAV;
LLINE ← LLSAV;
RSIDE ← RSAV;
LSIDE ← LSAV;
OUTSTR("type a carriage return to take the picture(s)");
INCHWL;
IF SIXBIT THEN HE2Q(PIC);
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN
BEGIN "TAKE" INTEGER N;
EXTERNAL INTEGER IND;
CWHEEL(6);
IF IND≠COLNUM[I] THEN
BEGIN
CWHEEL(COLNUM[I]);
N ← 12000;
WHILE N←N-1 DO;
END;
TVWORD ← PICALLOC[I];
IF SIXBIT THEN
BEGIN
TCLIP ← 0;
BCLIP ← 7;
TVSIX(PIC,SUMS,CLPINC);
END ELSE BEGIN
BCLIP ← CLIPS[I,1];
TCLIP ← CLIPS[I,2];
TVIN;
END;
END "TAKE";
IF SIXBIT THEN Q2HE(PIC);
α and add a transform if wanted;
QUEST(|If this picture is to be used by the hand/eye system"
&crlf&"it should have a camera transform|,
|store a camera transform (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
BEGIN
IF ¬CAMERR THEN CAMERR←CAMERR∨(CAM_UPDATE=10);
IF CAMERR THEN OUTSTR("CAMERA ERROR - NO TRANSFORM"
&CRLF) ELSE BEGIN
PICALLOC[7] ← GETCOR(30);
ARRTOR(BHEAD(|PICALLOC[7]|),
CAMERA_MODEL[1,1],30);
END;
END;
END "TVIN";
α apply the hipass filter;
QUEST(|You may apply a filter to the picture to enhance"&
" the edges|,
|Hipass filter (No or Yes)?|,
|ANS←INCHWL="Y"∨ANS="N"|);
IF ANS="Y" THEN FOR I←1 STEP 1 UNTIL 4 DO
IF PICALLOC[I] THEN
BEGIN
TVWORD ← PICALLOC[I];
HIPASS;
END;
α display the picture, if clear picture;
IF PICALLOC[1] THEN
BEGIN "DDVID"
QUEST(|you can display your picture on the data disk "&
"displays"&crlf&"if DDVID[1,PDQ] is running "&
"somewhere. The picture will be"&crlf&
"on channel 47|,
|display with DDVID (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
BEGIN
TVWORD←PICALLOC[1];
WHILE TRUE DO
BEGIN INTEGER J;
J←VIDEO(1,10,10);
IF J THEN DONE;
OUTSTR("Video failed. Try again (Y or N)?"&
CRLF);
IF INCHWL≠"Y" THEN DONE;
END;
END;
END "DDVID";
α print the picture(s) if desired;
QUEST (|Now you can output the picture(s) to the line printer, if "&
"you wish,"&crlf&"either by printing the intensity values,"&
" or simulating grey scale.|,
|print Grey scale (4 bit images only), Intensities, "&
"or Nothing?|,
|((ANS←INCHWL)="G"∧BITS=4)∨ANS="I"∨ANS="N"|);
IF ANS≠"N" THEN
BEGIN "PRINT" LABEL LOOP2;
IF ANS="G" THEN PRTBUF←GETCOR(TVLENG);
LOOP2: OPEN(1,"LPT",0,0,2,1000,I,I);
OUT(1,TITLE&CRLF);
OUT(1,DESCRIPT&CRLF);
OUT(1,CRLF&"UNDER FILTERS: ");
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN
OUT(1," "&FILNAM[I]);
OUT(1,CRLF);
RELEASE(1);
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN
BEGIN
TVWORD ← PICALLOC[I];
IF ANS="G" THEN PORTR ELSE PRDUMP;
END;
OUTSTR("another copy (Yes or No)?"&CRLF);
IF INCHWL="Y" THEN GO TO LOOP2;
IF ANS="G" THEN RELCOR(PRTBUF);
END "PRINT";
α set up to output to disk if desired;
QUEST (| |,|send picture(s) to the disk (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
BEGIN "DSKOUT"
INTEGER FILE, PPN, EXTEN, FAIL;
LABEL LOOP3;
IF LENGTH(TITLE) THEN
OUTSTR("title is: "&TITLE&CRLF&"would you like to "&
"change it (No or Yes)?") ELSE
OUTSTR("there is no title"&crlf&"would you like "&
"one (Yes or No)?");
IF INCHWL="Y" THEN
BEGIN
OUTSTR("type new title, ending with carriage return"
&crlf);
TITLE ← INCHWL;
END;
IF LENGTH(DESCRIPT) THEN
BEGIN
OUTSTR("would you like to see the description again"
&" (Yes or No)?");
IF INCHWL="Y" THEN OUTSTR(DESCRIPT&CRLF);
OUTSTR("would you like to change the description "&
"(No or Yes)?");
END ELSE OUTSTR("would you like to add a "&
"description (Yes of No)?");
IF INCHWL="Y" THEN
BEGIN
IF LENGTH(DESCRIPT) THEN
BEGIN
OUTSTR("Add to or Replace?");
IF INCHWL="R" THEN DESCRIPT ← NULL;
END;
OUTSTR("type new description or addition, ending "&
"with carraige return ∀ carriage return");
WHILE TRUE DO IF LENGTH(STR←INCHWL)∧STR[1 FOR 1]="∀"
THEN DONE ELSE DESCRIPT ← DESCRIPT&STR&CRLF;
END;
IF PICALLOC[5] THEN RELCOR(PICALLOC[5]);
IF PICALLOC[6] THEN RELCOR(PICALLOC[6]);
PICALLOC[5] ← IF LENGTH(TITLE) THEN ARRYCOM(TITLE) ELSE 0;
PICALLOC[6] ← IF LENGTH(DESCRIPT) THEN
ARRYCOM(DESCRIPT) ELSE 0;
FOR I←1 STEP 1 UNTIL 25 DO
PNTRS[I]←IF PICALLOC[I] THEN PICALLOC[I]+1 ELSE 0;
α and write it out;
LOOP3: OUTSTR("FILE NAME=");
FILE ← CVFIL(STR←INCHWL,EXTEN,PPN);
PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
IF FAIL THEN
BEGIN
USERERR(0,0,"WRITING OF FILE "&STR&" FAILED");
GO TO LOOP3;
END;
OUTSTR("FILE "&STR&" WRITTEN OUT"&CRLF);
END "DSKOUT";
α return for next picture;
FOR I←1 STEP 1 UNTIL 25 DO
BEGIN
IF PICALLOC[I] THEN RELCOR(PICALLOC[I]);
PICALLOC[I] ← PNTRS[I] ← 0;
END;
OUTSTR("another picture (Yes or No)?");
IF INCHWL ="Y" THEN
BEGIN
IF ¬EXP THEN
BEGIN
OUTSTR("are you an expert yet (Yes or No)?");
EXP ← INCHWL="Y";
END;
GO TO LOOP;
END;
END;